home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr27 / gs26.zip / WRFONT.PS < prev    next >
Text File  |  1993-01-22  |  10KB  |  312 lines
  1. %    Copyright (C) 1991, 1993 Aladdin Enterprises.  All rights reserved.
  2. %    Distributed by Free Software Foundation, Inc.
  3. %
  4. % This file is part of Ghostscript.
  5. %
  6. % Ghostscript is distributed in the hope that it will be useful, but
  7. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  8. % to anyone for the consequences of using it or for whether it serves any
  9. % particular purpose or works at all, unless he says so in writing.  Refer
  10. % to the Ghostscript General Public License for full details.
  11. %
  12. % Everyone is granted permission to copy, modify and redistribute
  13. % Ghostscript, but only under the conditions described in the Ghostscript
  14. % General Public License.  A copy of this license is supposed to have been
  15. % given to you along with Ghostscript so you can know your rights and
  16. % responsibilities.  It should be in a file named COPYING.  Among other
  17. % things, the copyright notice and this notice must be preserved on all
  18. % copies.
  19.  
  20. % wrfont.ps
  21. % Write out a Type 1 font in readable, reloadable form.
  22. % Note that this does NOT work on protected fonts, such as Adobe fonts
  23. % (unless you have loaded unprot.ps first, in which case you may be
  24. % violating the Adobe license).
  25.  
  26. % ------ Options ------ %
  27.  
  28. % Define whether to write out the CharStrings in binary or in hex.
  29. % Binary takes less space on the file, but isn't guaranteed portable.
  30.    /binary false def
  31.  
  32. % Define whether to use binary token encodings for the CharStrings.
  33. % Binary tokens are smaller and load faster, but are a Level 2 feature.
  34. % If binary_tokens is true, encrypt_CharStrings is ignored (always true).
  35.    /binary_tokens false def
  36.  
  37. % Define whether to encrypt the CharStrings on the file.  (CharStrings
  38. % are always encrypted in memory.)  This increases loading time slightly,
  39. % but it makes the files compress much better for transport.
  40.    /encrypt_CharStrings true def
  41.  
  42. % ------ Output utilities ------ %
  43.  
  44. % By convention, the output file is named psfile.
  45.  
  46. % Define some utilities for writing the output file.
  47.    /wtstring 100 string def
  48.    /wb {psfile exch write} bind def
  49.    /wnb {/wb load repeat} bind def
  50.    /ws {psfile exch writestring} bind def
  51.    /wl {ws (\n) ws} bind def
  52.    /wt {wtstring cvs ws ( ) ws} bind def
  53.    /wd        % Write a dictionary.
  54.     { dup length wt (dict dup begin) wl { we } forall
  55.       (end) ws
  56.     } bind def
  57.    /wld        % Write a large dictionary more efficiently.
  58.            % Ignore the readonly attributes.
  59.     { dup length wt (dict dup begin) wl
  60.       0 exch
  61.        { exch wo wo
  62.      1 add dup 200 eq
  63.       { wo ({def} repeat) wl 0 }
  64.      if
  65.        }
  66.       forall
  67.       dup 0 ne
  68.        { wo ({def} repeat) wl }
  69.        { pop }
  70.       ifelse
  71.       (end) ws
  72.     } bind def
  73.    /we        % Write a dictionary entry.
  74.     { exch wo wo /def cvx wo (\n) ws
  75.     } bind def
  76.    /wcs        % Write a CharString (or Subrs entry)
  77.     { dup length string copy
  78.       binary_tokens
  79.        { % Suppress recognizing the readonly status of the string.
  80.          wo
  81.        }
  82.        { encrypt_CharStrings not { 4330 exch dup type1decrypt exch pop } if
  83.          readonly dup length wo ( ) ws readproc ws wx
  84.        }
  85.       ifelse
  86.     } bind def
  87.  
  88. % Construct the inversion of the system name table.
  89.    /SystemNames where
  90.     { pop /snit 256 dict def
  91.       0 1 255
  92.        { dup SystemNames exch get
  93.          dup null ne { exch snit 3 1 roll put } { pop pop } ifelse
  94.        }
  95.       for
  96.     }
  97.     { /snit 1 dict def
  98.     }
  99.    ifelse
  100.  
  101. % Write an object, using binary tokens if requested and possible.
  102.    /woa        % write in ascii
  103.     { psfile exch write==only
  104.     } bind def
  105.     % Lookup table for ASCII output.
  106.    /intbytes    % int nbytes -> byte*
  107.     { exch { dup 255 and exch -8 bitshift } repeat pop
  108.     } bind def
  109.    /wotta 8 dict dup begin
  110.     { /booleantype /integertype /nulltype /realtype }
  111.     { { ( ) ws woa } def }
  112.    forall
  113.      /nametype
  114.       { dup xcheck { ( ) ws } if woa
  115.       } bind def
  116.     { /arraytype /packedarraytype /stringtype }
  117.     { { dup woa wop } def }
  118.    forall
  119.    end def
  120.     % Lookup table for binary output.
  121.    /wottb 8 dict dup begin
  122.    wotta currentdict copy pop
  123.      /integertype
  124.       { dup dup 127 le exch -128 ge and
  125.          { 136 wb 255 and wb
  126.      }
  127.      { ( ) ws woa
  128.      }
  129.     ifelse
  130.       } bind def
  131.      /nametype
  132.       { dup snit exch known
  133.          { dup xcheck { 146 } { 145 } ifelse wb
  134.        snit exch get wb
  135.      }
  136.      { wotta /nametype get exec
  137.      }
  138.     ifelse
  139.       } bind def
  140.      /stringtype
  141.       { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
  142.         ws wop
  143.       } bind def
  144.    end def
  145.    /wop        % Write object protection
  146.      { wcheck not { /readonly cvx wo } if
  147.      } bind def
  148.    /wo        % Write an object.
  149.      { dup type binary_tokens { wottb } { wotta } ifelse
  150.        exch get exec
  151.      } bind def
  152.  
  153. % Write a hex string for Subrs or CharStrings.
  154.    /wx        % string ->
  155.     { binary
  156.        { ws
  157.        }
  158.        { % Some systems choke on very long lines, so
  159.      % we break up the hexstring into chunks of 50 characters.
  160.       { dup length 25 le {exit} if
  161.         dup 0 25 getinterval psfile exch writehexstring (\n) ws
  162.         dup length 25 sub 25 exch getinterval
  163.       } loop
  164.      psfile exch writehexstring
  165.        } ifelse
  166.     } bind def
  167.  
  168. % ------ The main program ------ %
  169.  
  170. % Define the dictionary of actions for special entries in the dictionaries.
  171. % We lump the font and the Private dictionary together, because
  172. % the set of keys doesn't overlap.
  173. [/CharStrings /Encoding /FID /FontInfo /Metrics /Private /Subrs]
  174. dup length dict begin
  175.  { null cvx def } forall
  176. currentdict end /specialkeys exch def
  177.  
  178. % Define the procedures for the Private dictionary.
  179. % These must be defined without `bind',
  180. % for the sake of the DISKFONTS feature.
  181. 4 dict begin
  182.  /-! {string currentfile exch readhexstring pop} def
  183.  /-| {string currentfile exch readstring pop} def
  184.  /|- {readonly def} def
  185.  /| {readonly put} def
  186. currentdict end /encrypted_procs exch def
  187. 4 dict begin
  188.  /-! {string currentfile exch readhexstring pop
  189.    4330 exch dup type1encrypt exch pop} def
  190.  /-| {string currentfile exch readstring pop
  191.    4330 exch dup type1encrypt exch pop} def
  192.  /|- {readonly def} def
  193.  /| {readonly put} def
  194. currentdict end /unencrypted_procs exch def
  195.  
  196. % Construct an inverse dictionary of encodings.
  197. 3 dict begin
  198.  StandardEncoding /StandardEncoding def
  199.  ISOLatin1Encoding /ISOLatin1Encoding def
  200.  SymbolEncoding /SymbolEncoding def
  201. currentdict end /encodingnames exch def
  202.  
  203. /writefont        % psfile -> [writes the current font]
  204.  { /psfile exch def
  205.    /Font currentfont def
  206.    /readproc binary { (-| ) } { (-! ) } ifelse def
  207.    /privateprocs
  208.      encrypt_CharStrings binary_tokens not and
  209.       { encrypted_procs } { unencrypted_procs } ifelse
  210.      def
  211.    (%!FontType1-1.0: ) ws currentfont /FontName get wt (000.000) wl
  212.  
  213. % Turn on binary tokens if relevant.
  214.    binary_tokens { (currentobjectformat 1 setobjectformat) wl } if
  215.  
  216. % If the file has a UniqueID, write out a check against loading it twice.
  217.    Font /UniqueID known
  218.     { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
  219.       ( {) ws wo ( findfont dup /UniqueID known) wl
  220.       (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
  221.       (    { pop false } ifelse) wl
  222.       (    { pop save /restore load } if) wl
  223.       ( } if) wl
  224.     }
  225.    if
  226.  
  227. % Write out the creation of the font dictionary and FontInfo.
  228.    Font length 1 add wt (dict begin) wl        % +1 for FontFile
  229.    Font begin
  230.    (/FontInfo ) ws FontInfo wd ( readonly def) wl
  231.  
  232. % Write out the other fixed entries in the font dictionary.
  233.    Font
  234.     { 1 index specialkeys exch known
  235.        { pop pop } { we } ifelse
  236.     } forall
  237.    /Encoding
  238.    encodingnames Encoding known
  239.     { encodingnames Encoding get cvx }
  240.     { Encoding }
  241.    ifelse we
  242.  
  243. % Write out the Metrics, if any.
  244.    Font /Metrics known
  245.     { (/Metrics ) ws Metrics wld ( readonly def) wl
  246.     }
  247.    if
  248.  
  249. % Close the font dictionary.
  250.    (currentdict end) wl
  251.  
  252. % The rest of the file could be in eexec form, but we don't see any point
  253. % in doing this, because we aren't attempting to conceal it from anyone.
  254.  
  255. % Create and initialize the Private dictionary.
  256.    Private dup length privateprocs length add dict copy begin
  257.    privateprocs { readonly def } forall
  258.    (dup /Private ) ws currentdict length 1 add wt (dict dup begin) wl
  259.    currentdict
  260.     { 1 index specialkeys exch known
  261.        { pop pop } { we } ifelse
  262.     } forall
  263.  
  264. % Write the Subrs entries, if any.
  265.    currentdict /Subrs known
  266.     { (/Subrs ) ws Subrs length wt (array) wl
  267.       0 1 Subrs length 1 sub
  268.        { dup Subrs exch get dup null ne
  269.       { /dup cvx wo exch wo wcs ( |) wl }
  270.       { pop pop }
  271.      ifelse
  272.        } for
  273.       (readonly def) wl
  274.     }
  275.    if
  276.  
  277. % Write the CharStrings entries.
  278.    (2 index /CharStrings ) ws
  279.    CharStrings length wt (dict dup begin) wl
  280.    CharStrings
  281.     { exch wo wcs ( |-) wl
  282.     } forall
  283.  
  284. % Wrap up the private part of the font.
  285.    (end) wl        % CharStrings
  286.    (end) wl        % Private
  287.    end            % Private
  288.    (readonly put) wl    % CharStrings in font
  289.    (readonly put) wl    % Private in font
  290.    end            % Font
  291.  
  292. % Terminate the output.
  293.    (dup /FontName get exch definefont pop) wl
  294.    Font /UniqueID known { (exec) wl } if
  295.    binary_tokens { (setobjectformat) wl } if
  296.  
  297.  } bind def
  298.  
  299. % ------ Other utilities ------ %
  300.  
  301. % Prune garbage characters and OtherSubrs out of the current font,
  302. % if the relevant dictionaries are writable.
  303. /prunefont
  304.  { currentfont /CharStrings get wcheck
  305.     { currentfont /CharStrings get dup [ exch
  306.        { pop dup (S????00?) stringmatch not { pop } if
  307.        } forall
  308.       ] { 2 copy undef pop } forall pop
  309.     }
  310.    if
  311.  } bind def
  312.